home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tj50dsk1.zip / READTTT5.PAS < prev    next >
Pascal/Delphi Source File  |  1989-01-31  |  36KB  |  1,103 lines
  1. {--------------------------------------------------------------------------}
  2. {                         TechnoJock's Turbo Toolkit                       }
  3. {                                                                          }
  4. {                              Version   5.00                              }
  5. {                                                                          }
  6. {                                                                          }
  7. {              Copyright 1986, 1989 TechnoJock Software, Inc.              }
  8. {                           All Rights Reserved                            }
  9. {                          Restricted by License                           }
  10. {--------------------------------------------------------------------------}
  11.  
  12.                      {--------------------------------}                                       
  13.                      {       Unit:  ReadTTT5          }
  14.                      {--------------------------------}
  15.  
  16.  
  17. {$S-,R-,V-,D-}       
  18.  
  19. Unit ReadTTT5;
  20.  
  21. Interface
  22.  
  23. Uses CRT,FastTTT5,WinTTT5,StrnTTT5,KeyTTT5;
  24.  
  25. Type
  26.    R_Display = record
  27.                     WhiteSpace  : char;        {used to pad input field - default ··········} 
  28.                     AllowEsc    : boolean;     {allow the he user to escape?} 
  29.                     Beep        : Boolean;     {allow the old proverbial beep} 
  30.                     Insert      : boolean;     {initially in insert mode?} 
  31.                     BegCursor   : boolean;     {place cursor at beginning of line} 
  32.                     AllowNull   : boolean;     {allow user to input a '' or null value} 
  33.                     RightJustify: Boolean;     {right justify string on termination} 
  34.                     EraseDefault: Boolean;     {clear entry of alphanumeric pressed} 
  35.                     SuppressZero: Boolean;     {have empty field is value = zero}
  36.                     FCol        : byte;        {normal foreground color of input field}
  37.                     BCol        : byte;        {normal background of input field}
  38.                     HiFCol      : byte;        {highlighted fgnd color for Read_Select}
  39.                     HiBCol      : byte;        {highlighted bgnd color for Read_Select}
  40.                     LoFCol      : byte;        {normal fgnd color for Read_Select}
  41.                     LoBCol      : byte;        {normal bgnd color for Read_Select}
  42.                     PFcol       : byte;        {prompt foreground color}
  43.                     PBCol       : byte;        {prompt background color}
  44.                     BoxFCol     : byte;        {box foreground color}
  45.                     BoxBCol     : byte;        {Box background color}
  46.                     Msg_FCol    : byte;        {Foreground color for error messages}
  47.                     Msg_BCol    : byte;        {Background color for error messages}
  48.                     Msg_Line    : byte;        {line for error messages}
  49.                     End_chars   : set of char; {end of input chars}
  50.                     RealDP      : byte;        {no of decimal places on real}
  51.                end;
  52.  
  53. const
  54.     NoPrompt:string[1] = '';
  55. Var
  56.   RTTT : R_Display;
  57.   R_Char : char;
  58.   R_Null : boolean;
  59.  
  60. Procedure Default_Settings;
  61. Procedure ReadLine(X,Y,L,F,B:byte;var Text: string;var Retcode:integer);
  62. Procedure Read_String(X,Y,L:byte;
  63.                       Prompt:StrScreen; 
  64.                       BoxType: byte;
  65.                       Var Txt:StrScreen);
  66. Procedure Read_String_Upper(X,Y,L:byte;
  67.                             Prompt:StrScreen;
  68.                             BoxType: byte;
  69.                             Var Txt:StrScreen);
  70. Procedure Read_Password(X,Y,L:byte;
  71.                         Prompt:StrScreen;
  72.                         BoxType: byte;
  73.                         Var Txt:StrScreen);
  74. Procedure Read_Alpha(X,Y,L:byte;
  75.                      Prompt:StrScreen;
  76.                      BoxType: byte;
  77.                      Var Txt:StrScreen);
  78. Procedure Read_YN(X,Y:byte;
  79.                   Prompt:StrScreen;
  80.                   BoxType: byte;
  81.                   Var Yes:Boolean);
  82. Procedure Read_Byte(X,Y,L:byte; 
  83.                     Prompt:StrScreen;
  84.                     BoxType: byte;
  85.                     Var B : Byte;
  86.                     Min, Max : Byte);
  87. Procedure Read_Word(X,Y,L:byte; 
  88.                     Prompt:StrScreen;
  89.                     BoxType: byte;
  90.                     Var W : word;
  91.                     Min, Max : word);
  92. Procedure Read_Int(X,Y,L:byte;
  93.                    Prompt:StrScreen;
  94.                    BoxType: byte;
  95.                    Var W : integer;
  96.                    Min, Max : integer);
  97. Procedure Read_LongInt(X,Y,L:byte;
  98.                        Prompt:StrScreen;
  99.                        BoxType: byte;
  100.                        Var W : longint;
  101.                        Min, Max : longint);
  102. Procedure Read_Real(X,Y,L:byte;
  103.                     Prompt:StrScreen;
  104.                     BoxType: byte;
  105.                     Var W : real;
  106.                     Min, Max : real);
  107. Procedure Read_Select(X,Y:byte;Pmt,Txt:StrScreen;var Choice:byte);
  108. Implementation
  109.  
  110. CONST
  111.     PassChar    = #15;
  112.     CursorRight = #205;
  113.     CursorLeft  = #203;
  114.     CursorDown  = #208;
  115.     CursorUp    = #200;
  116.     EnterKey    = #13;
  117.     EscKey      = #27;
  118.     EndKey      = #207;
  119.     HomeKey     = #199;
  120.     DelKey      = #211;
  121.     Backspace   = #8;
  122.     InsKey      = #210;
  123.     Zap         = #160;      {Alt D to delete the field}
  124.     MinInt              = -32768;
  125.     MaxLongInt:longint  =  2147483647;
  126.     MinLongInt:longint  = -2147483647;
  127.     MaxWord             =  65535;
  128.     MinWord             =  0;
  129.     
  130. VAR
  131.    Cursor_X,
  132.    Cursor_Y,
  133.    ScanTop,
  134.    ScanBot   : byte;
  135.  
  136. Procedure Default_Settings;
  137. begin
  138.    with RTTT do
  139.    begin
  140.        WhiteSpace   := #250;
  141.        Beep         := true;
  142.        BegCursor    := false;
  143.        Insert       := false;
  144.        AllowEsc     := true;
  145.        AllowNull    := true;
  146.        RightJustify := false;
  147.        EraseDefault := false;
  148.        SuppressZero := true;
  149.        End_Chars := [#13];  {Enter}
  150.        RealDP := 2;  
  151.        If BaseOfScreen = $B000 then
  152.        begin
  153.            FCol := black;
  154.            BCol := lightgray;
  155.            HiFCol := white;
  156.            HiBCol := black;
  157.            LoFCol := lightgray;
  158.            LoBCol := black;
  159.            PFCol := white;
  160.            PBCol := black;
  161.            BoxFCol := white;
  162.            BoxBCol := black;
  163.            Msg_FCol := white;
  164.            Msg_BCol := black;
  165.            Msg_Line := 0;
  166.        end
  167.        else
  168.        begin
  169.            FCol := black;
  170.            BCol := lightgray;
  171.            HiFCol := black;
  172.            HiBCol := lightgray;
  173.            LoFCol := lightgray;
  174.            LoBCol := black;
  175.            PFCol := white;
  176.            PBCol := black;
  177.            BoxFCol := white;
  178.            BoxBCol := black;
  179.            Msg_FCol := lightred;
  180.            Msg_BCol := black;
  181.            Msg_Line := 0;
  182.        end;
  183.    end;
  184. end;
  185.  
  186. Procedure Clang;
  187. begin
  188.     If RTTT.Beep then
  189.     begin
  190.         sound(500);
  191.         delay(50);
  192.         nosound;
  193.     end;
  194. end;
  195.  
  196. Procedure Read_Line(X,Y,L,F,B,Format:byte;
  197.                      var Text   :string);
  198. {
  199. X is X coord of first character in field
  200. Y is Y coord of field
  201. L is the maximum length of the input field
  202. F is the foreground color
  203. B is the background color
  204. Fornat Codes:      1   Any String
  205.                    2   Force Upper String
  206.                    3   Yes/No
  207.                    4   Alphabetics only
  208.                    5   Integer
  209.                    6   LongInteger
  210.                    7   Real
  211.                    8   Word
  212.                    (*   Maybe
  213.                    9   Date    (MM/DD/YY)
  214.                    10  Date    (DD/MM/YY)
  215.                    *)
  216.                    11  Echo a Password
  217. Text is a string updated with the string equivalent of user input
  218. }
  219. var
  220.     TempText : string;
  221.     CursorPos : byte;
  222.     InsertMode,
  223.     Password,
  224.     Alldone : boolean;
  225.     FirstCharPress: boolean;
  226.     Ch : char;
  227.  
  228.     Procedure Check_Parameters;
  229.     begin
  230.         TempText := Text;
  231.         If length(TempText) > L then
  232.            Delete(Temptext,L+1,length(TempText)-L);
  233.         If not X in [1..80] then
  234.            X := 1;
  235.         If X + L - 1 > 80 then X := 81 - L;
  236.         If not Y in [1..25] then
  237.            Y := 1;
  238.         If RTTT.BegCursor then
  239.            CursorPos := 1
  240.         else
  241.         begin
  242.             If length(TempText) < L then
  243.                CursorPos := length(TempText) + 1
  244.             else
  245.                CursorPos := length(TempText);
  246.         end;
  247.         InsertMode  := RTTT.Insert;
  248.         Alldone := False;
  249.         If Format = 11 then
  250.         begin
  251.             Password := true;
  252.             Format := 1;
  253.         end
  254.         else
  255.            Password := false;
  256.     end;  {sub Proc Check_Parameters}
  257.  
  258.     Function FillWhiteSpace(Str:string):string;
  259.     var I : integer;
  260.     begin
  261.         If Password then
  262.            Str := replicate(length(Str),PassChar);
  263.         while length(Str) < L do
  264.               Str := Str + RTTT.WhiteSpace;
  265.         FillWhiteSpace := Str;
  266.     end; {sub Func FillWhiteSpace}
  267.  
  268.     Procedure MoveTheCursor;
  269.     begin
  270.         GotoXY(X+CursorPos-1,Y);
  271.     end;  {sub Proc MoveTheCursor}
  272.  
  273.     Procedure Write_String;
  274.     begin
  275.         Fastwrite(X,Y,attr(F,B),FillWhiteSpace(TempText));
  276.         MoveTheCursor;
  277.     end;
  278.  
  279.     Procedure Erase_Field;
  280.     begin
  281.         TempText := '';
  282.         CursorPos := 1;
  283.         Write_String;
  284.     end;
  285.  
  286.     Procedure Char_Backspace;
  287.     begin
  288.         If CursorPos > 1 then
  289.         begin
  290.             CursorPos := Pred(CursorPos);
  291.             Delete(TempText,CursorPos,1);
  292.             Write_String;
  293.        end;
  294.     end;   {sub Proc Char_Backspace}
  295.  
  296.     Procedure Char_Del;
  297.     begin
  298.         If CursorPos <= length(TempText) then
  299.         begin
  300.             Delete(TempText,CursorPos,1);
  301.             Write_String;
  302.         end;
  303.     end;   {sub Proc Char_Del}
  304.  
  305.     Procedure Add_Char(Ch:char);
  306.     begin
  307.         If InsertMode then
  308.         begin
  309.             If length(TempText) < L then
  310.             begin
  311.                 Insert(Ch,TempText,CursorPos);
  312.                 If CursorPos < L then
  313.                    CursorPos := Succ(CursorPos);
  314.            end;
  315.         end
  316.         else {not insertmode}
  317.         begin
  318.             Delete(TempText,CursorPos,1);
  319.             Insert(Ch,TempText,CursorPos);
  320.             If CursorPos < L then
  321.                CursorPos := Succ(CursorPos);
  322.         end;   {if insert}
  323.         Write_String;
  324.     end;   {sub proc Add_Char}
  325.  
  326.  
  327. begin                  {main Procedure Read_Line}
  328.     Check_Parameters;
  329.     R_Null := false;
  330.     FindCursor(Cursor_X,Cursor_Y,ScanTop,ScanBot);
  331.     If RTTT.Insert then
  332.        HalfCursor
  333.     else
  334.        OnCursor;
  335.     Write_String;
  336.     FirstCharPress := true;
  337.     Repeat
  338.          Ch := Getkey;
  339.          If Format in [2,3] then
  340.             Ch := upcase(Ch);
  341.          If Ch in RTTT.End_Chars then
  342.          begin
  343.             AllDone := True;
  344.             If Ch <> #027 then Text := TempText;
  345.          end
  346.          else
  347.          Case Ch of
  348.          #131,              {mouseright}
  349.          CursorRight   :  begin
  350.                               If (CursorPos < L)
  351.                               and (CursorPos <= length(TempText)) then
  352.                               begin
  353.                                   CursorPos := Succ(CursorPos);
  354.                                   MoveTheCursor;
  355.                               end;
  356.                           end;
  357.          #130,               {mouseleft}
  358.          CursorLeft    :  begin
  359.                               If CursorPos > 1 then
  360.                               begin
  361.                                   CursorPos := Pred(CursorPos);
  362.                                   MoveTheCursor;
  363.                               end;
  364.                           end;
  365.          HomeKey       :  begin
  366.                               CursorPos := 1;
  367.                               MoveTheCursor;
  368.                           end;
  369.          EndKey        :  begin
  370.                               If CursorPos < L then
  371.                               If length(TempText) < L then
  372.                                   CursorPos := length(TempText) + 1
  373.                               else
  374.                                   CursorPos := L;
  375.                               MoveTheCursor;
  376.                           end;
  377.         InsKey        :  If Format <> 3 then   {don't allow insert on Y/N!}
  378.                          begin
  379.                              InsertMode := not InsertMode;
  380.                              If InsertMode then
  381.                                 HalfCursor
  382.                              else
  383.                                 OnCursor;
  384.                          end;
  385.         DelKey        :  Char_Del;
  386.         BackSpace     :  Char_Backspace;
  387.         Zap           :  Erase_Field;
  388.         EscKey        :  If RTTT.AllowEsc then
  389.                              Alldone := true
  390.                          else
  391.                             Clang;
  392.         EnterKey      :  begin
  393.                              Alldone := true;
  394.                              Text := TempText;
  395.                          end;
  396.        #33 .. #42,                                 {! to *}
  397.        #44,#47,                                    {, /}
  398.        #58 .. #64,                                 {: to @}
  399.        #91 .. #96,                                 {[ to '}
  400.        #123 .. #126   :  If (Format in [1,2]) then {{ to ~}
  401.                          begin
  402.                              If FirstCharPress and RTTT.EraseDefault then
  403.                                 Erase_Field;
  404.                              Add_Char(Ch);
  405.                          end
  406.                          else
  407.                              Clang;
  408.        #43, #45       : If (Format in [1,2])       { + - }
  409.                         or ( (CursorPos=1) and (Format in [5,6,7])) then
  410.                         begin
  411.                             If FirstCharPress and RTTT.EraseDefault then
  412.                                 Erase_Field;
  413.                             Add_Char(Ch);
  414.                         end
  415.                         else
  416.                            Clang;
  417.        #46            : If (Format in [1,2])       {.}
  418.                         or ( (Pos('.',TempText)=0) and (Format = 7)) then
  419.                         begin
  420.                             If FirstCharPress and RTTT.EraseDefault then
  421.                                 Erase_Field;
  422.                             Add_Char(Ch);
  423.                         end
  424.                         else
  425.                            Clang;
  426.        #48..#57       : If (Format in [1..2,5..8]) then {0 to 9}
  427.                         begin
  428.                             If FirstCharPress and RTTT.EraseDefault then
  429.                                 Erase_Field;
  430.                             Add_Char(Ch);
  431.                         end
  432.                         else
  433.                            Clang;
  434.        #32,                                              {space}
  435.        #65..#77,                                         {A to M}
  436.        #79..#88,                                         {O to X}
  437.        #90,                                              {Z}
  438.        #97..#122      : If (Format in [1,2,4]) then      {a to z}
  439.                         begin
  440.                             If FirstCharPress and RTTT.EraseDefault then
  441.                                 Erase_Field;
  442.                             Add_Char(Ch);
  443.                         end
  444.                         else
  445.                            Clang;
  446.        #78,#89        : If (Format in [1..4]) then        {N Y}
  447.                         begin
  448.                             Add_Char(Ch);
  449.                             If Format = 3 then
  450.                             begin
  451.                                 Alldone := true;
  452.                                 Text := TempText;
  453.                             end;
  454.                         end
  455.                         else
  456.                            Clang;
  457.       #128,#129       :;    {absorb stray mouse movement to avoid Clang'n}
  458.       else Clang;
  459.       end; {case}
  460.       FirstCharPress := false;
  461.       Until Alldone;
  462.       R_Char := Ch;
  463.       If  RTTT.RightJustify
  464.       and (Format > 4) then
  465.       begin
  466.           Fastwrite(X,Y,attr(F,B),replicate(L,RTTT.Whitespace));
  467.           Fastwrite(X+L-Length(TempText),Y,attr(F,B),Text);
  468.       end
  469.       else
  470.         Fastwrite(X,Y,attr(F,B),FillWhiteSpace(Text));
  471.       GotoXY(Cursor_X,Cursor_Y);
  472.       SizeCursor(ScanTop,ScanBot);
  473. end;  {Proc Read_Line}
  474.  
  475. Procedure Display_Box_and_Prompt(var X1,Y: byte;
  476.                                  BoxType:byte;
  477.                                  Prompt: StrScreen;
  478.                                  L:byte);
  479. {ensures that the input will fit on the screen, then draws box and prompt}
  480. const
  481.    Upchar = '^';
  482.    DnChar = '_';
  483. var
  484.   P,
  485.   width:byte;
  486.   InBorder : byte;    {is title in box border - 0 no, 1 upper, 2 lower}
  487. begin
  488.     If not ( (Y-ord(BoxType > 0)) in [1..DisplayLines] ) then
  489.        Y := 2;
  490.     If (X1 < 1) then
  491.        X1 := 2;
  492.     P := length(Prompt);
  493.     If (P > 1) and (Boxtype > 0) then    {check and see if prompt is in box}
  494.     begin
  495.        If Prompt[1] = Upchar then
  496.        begin
  497.            delete(Prompt,1,1);
  498.            dec(P);
  499.            InBorder := 1;
  500.        end
  501.        else
  502.           If Prompt[1] = DnChar then
  503.           begin
  504.               delete(Prompt,1,1);
  505.               dec(P);
  506.               InBorder := 2;
  507.           end
  508.           else
  509.              InBorder := 0;
  510.     end
  511.     else
  512.        InBorder := 0;
  513.     If InBorder > 0 then                      {determine dimensions of box}
  514.     begin
  515.         If P > L then
  516.            width := succ(P)
  517.         else
  518.            width := succ(L);
  519.     end
  520.     else
  521.        width := succ(P+l);
  522.     If pred(X1 + width) > 80 then
  523.        X1 :=  succ(80 - width);
  524.     If BoxType > 0 then         {draw the box}
  525.        FBox(X1,pred(Y),X1+width,succ(Y),RTTT.BoxFCol,RTTT.BoxBCol,BoxType);
  526.     If P > 0 then               {Draw the prompt}
  527.         Case InBorder of
  528.         0 : If BoxType> 0 then
  529.                Fastwrite(succ(X1),Y,attr(RTTT.PFcol,RTTT.PBCol),Prompt) {left Justified in upper border}
  530.             else
  531.                Fastwrite(X1,Y,attr(RTTT.PFcol,RTTT.PBCol),Prompt);
  532.         1 : FastWrite(succ(X1),pred(Y),attr(RTTT.PFcol,RTTT.PBCol),Prompt);
  533.         2 : FastWrite(X1+width-P,succ(Y),attr(RTTT.PFcol,RTTT.PBCol),Prompt);   {right justified in lower border}
  534.         end;
  535.     If InBorder > 0 then        {return var X1 adjusted to position of input field}
  536.     begin
  537.        If Boxtype > 0 then
  538.           X1 := succ(X1);
  539.     end
  540.     else
  541.     begin
  542.        If Boxtype > 0 then
  543.           X1 := succ(X1) + p
  544.        else
  545.           X1 := X1 + P;
  546.     end;
  547. end;
  548. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  549.  
  550.  Procedure ReadLine(X,Y,L,F,B:byte;var Text: string;var Retcode:integer);
  551.  {compatibility module with TTT 4.0}
  552.  begin
  553.      Read_Line(X,Y,L,F,B,1,Text);
  554.      If R_Char = #027 then
  555.         RetCode := 0
  556.      else
  557.         Retcode := 1;
  558.  end; {of proc ReadLine}
  559.  
  560.  
  561. Procedure Read_String(X,Y,L:byte;
  562.                       Prompt:StrScreen;
  563.                       BoxType: byte;
  564.                       Var Txt:StrScreen);
  565. begin
  566.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  567.     Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,1,Txt);
  568. end;
  569.  
  570. Procedure Read_String_Upper(X,Y,L:byte;
  571.                             Prompt:StrScreen;
  572.                             BoxType: byte;
  573.                             Var Txt:StrScreen);
  574. begin
  575.     Txt :=  Upper(Txt);
  576.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  577.     Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,2,Txt);
  578. end;
  579.  
  580. Procedure Read_Password(X,Y,L:byte;
  581.                         Prompt:StrScreen;
  582.                         BoxType: byte;
  583.                         Var Txt:StrScreen);
  584. begin
  585.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  586.     Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,11,Txt);
  587. end;
  588.  
  589. Procedure Read_Alpha(X,Y,L:byte;
  590.                      Prompt:StrScreen;
  591.                      BoxType: byte;
  592.                      Var Txt:StrScreen);
  593. begin
  594.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  595.     Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,4,Txt);
  596. end;
  597.  
  598. Procedure Read_YN(X,Y:byte;
  599.                   Prompt:StrScreen;
  600.                   BoxType: byte;
  601.                   Var Yes:Boolean);
  602.  
  603. var
  604.   Global_Insert : boolean;
  605.   Txt : StrScreen;
  606. begin
  607.     If Yes then
  608.        Txt := 'Y'
  609.     else
  610.        Txt := 'N';
  611.     Global_Insert := RTTT.insert;
  612.     RTTT.Insert := false;            {force to overwrite mode}
  613.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,1);
  614.     Read_Line(X,Y,1,RTTT.FCol,RTTT.BCol,3,Txt);
  615.     RTTT.Insert := Global_Insert;    {reset back}
  616.     If Txt = 'Y' then
  617.        Yes := true
  618.     else
  619.        Yes := false;
  620. end;
  621.  
  622. {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
  623.  
  624. Procedure Invalid_Message(Y : byte; var CH : char);
  625. begin
  626.    Clang;
  627.    TempMessageCH(1,Y,RTTT.Msg_Fcol,RTTT.Msg_BCol,
  628.                PadCenter('Invalid number - press any key to resume',80,' '),CH);
  629. end;
  630.  
  631. Procedure OutOfRange_Message(Y : byte;MinS,MaxS : StrScreen;var CH:char);
  632. var S : StrScreen;
  633. begin
  634.    Clang;
  635.    S := 'Error value must be in the range '+MinS+' to '+MaxS+' - press any key to resume';
  636.    TempMessageCh(1,Y,RTTT.Msg_Fcol,RTTT.Msg_BCol,PadCenter(S,80,' '),CH);
  637. end;
  638.  
  639. Function MessageLine(Y : byte):byte;
  640. begin
  641.     If (RTTT.Msg_Line = 0) or (RTTT.Msg_Line > DisplayLines) then
  642.     begin
  643.         If Y < DisplayLines then    {set message Line}
  644.            MessageLine := succ(Y)
  645.         else
  646.            MessageLine := pred(Y);
  647.     end
  648.     else
  649.        MessageLine := RTTT.Msg_Line;
  650. end;
  651.  
  652. {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
  653.  
  654. Procedure Read_Byte(X,Y,L:byte; 
  655.                     Prompt:StrScreen;
  656.                     BoxType: byte;
  657.                     Var B : byte; 
  658.                     Min, Max : byte);
  659. var
  660.    Temp : byte;
  661.    Txt : StrScreen;
  662.    Valid : boolean;
  663.    Code : integer;
  664.    YT : byte;
  665.    CHB : char;
  666. begin
  667.     If Max = 0 then
  668.       Max := 255;
  669.     If Min >= Max then
  670.        Min := 0;
  671.     If (B < Min) or (B > Max) then
  672.         B := Min;
  673.     If ((B = 0) and RTTT.SuppressZero) then
  674.        Txt := ''
  675.     else
  676.        Txt := Int_To_Str(B);
  677.     Temp := B;
  678.     Valid := false;
  679.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  680.     YT := MessageLine(Y);
  681.     Repeat
  682.          Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,8,Txt);
  683.          If ((R_Char = #027) and RTTT.AllowEsc)
  684.          or ((Txt = '') and (RTTT.AllowNull)) then
  685.          begin
  686.              If Txt = '' then R_Null := true;
  687.              exit;
  688.          end
  689.          else
  690.          begin
  691.              val(Txt,Temp,code);
  692.              If code <> 0 then
  693.              begin
  694.                 Invalid_Message(YT,CHB);
  695.                 If ChB = #027 then
  696.                         Txt := Int_To_Str(B);
  697.              end
  698.              else
  699.              begin
  700.                  If (Temp < Min) 
  701.                  or (Temp > Max) 
  702.                  or ((length(Txt) > 2) and (Txt > '255')) then
  703.                  begin
  704.                     OutOfRange_Message(Yt,Int_To_Str(Min),Int_To_Str(Max),CHB);
  705.                     If ChB = #027 then
  706.                         Txt := Int_To_Str(B);
  707.                  end
  708.                  else
  709.                  begin
  710.                      B := temp;
  711.                      Valid := true;
  712.                  end;
  713.              end;
  714.          end;
  715.     Until Valid or ((R_Char = #027) and RTTT.AllowEsc);
  716. end;
  717.  
  718. Procedure Read_Word(X,Y,L:byte; 
  719.                     Prompt:StrScreen;
  720.                     BoxType: byte;
  721.                     Var W : word; 
  722.                     Min, Max : word);
  723. var
  724.    Temp : word;
  725.    Txt : StrScreen;
  726.    Valid : boolean;
  727.    Code : integer;
  728.    YT : byte;
  729.    ChW : char;
  730. begin
  731.     If Max = 0 then
  732.       Max := MaxWord;
  733.     If Min >= Max then
  734.        Min := MinWord;
  735.     If (W < Min) or (W > Max) then
  736.         W := Min;
  737.     If ((W = 0) and RTTT.SuppressZero) then
  738.        Txt := ''
  739.     else
  740.        Txt := Int_To_Str(W);
  741.     Temp := W;
  742.     Valid := false;
  743.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  744.     YT := MessageLine(Y);
  745.     Repeat
  746.          Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,8,Txt);
  747.          If ((R_Char = #027) and RTTT.AllowEsc)
  748.          or ((Txt = '') and (RTTT.AllowNull)) then
  749.          begin
  750.              If Txt = '' then R_Null := true;
  751.              exit;
  752.          end
  753.          else
  754.          begin
  755.              val(Txt,Temp,code);
  756.              If code <> 0 then
  757.              begin
  758.                 Invalid_Message(YT,ChW);
  759.                 If ChW = #027 then
  760.                         Txt := Int_To_Str(W);
  761.              end
  762.              else
  763.              begin
  764.                  If (Temp < Min) 
  765.                  or (Temp > Max) 
  766.                  or ((length(Txt) > 4) and (Txt > Int_To_Str(MaxWord))) then
  767.                  begin
  768.                     OutOfRange_Message(Yt,Int_To_Str(Min),Int_To_Str(Max),ChW);
  769.                     If ChW = #027 then
  770.                         Txt := Int_To_Str(W);
  771.                  end
  772.                  else
  773.                  begin
  774.                      W := temp;
  775.                      Valid := true;
  776.                  end;
  777.              end;
  778.          end;
  779.     Until Valid  or ((R_Char = #027) and RTTT.AllowEsc);
  780. end;
  781.  
  782.  
  783. Procedure Read_Int(X,Y,L:byte;
  784.                    Prompt:StrScreen;
  785.                    BoxType: byte;
  786.                    Var W : integer;
  787.                    Min, Max : integer);
  788. var
  789.    Temp : integer;
  790.    Txt : StrScreen;
  791.    Valid : boolean;
  792.    Code : integer;
  793.    YT : byte;
  794.    ChI : char;
  795. begin
  796.     If Max = 0 then
  797.       Max := MaxInt;
  798.     If Min >= Max then
  799.        Min := MinInt;
  800.     If (W < Min) or (W > Max) then
  801.         W := Min;
  802.     If ((W = 0) and RTTT.SuppressZero) then
  803.        Txt := ''
  804.     else
  805.        Txt := Int_To_Str(W);
  806.     Temp := W;
  807.     Valid := false;
  808.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  809.     YT := MessageLine(Y);
  810.     Repeat
  811.          Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,5,Txt);
  812.          If ((R_Char = #027) and RTTT.AllowEsc)
  813.          or ((Txt = '') and (RTTT.AllowNull)) then
  814.          begin
  815.              If Txt = '' then R_Null := true;
  816.              exit;
  817.          end
  818.          else
  819.          begin
  820.              val(Txt,Temp,code);
  821.              If code <> 0 then
  822.              begin
  823.                 Invalid_Message(YT,ChI);
  824.                 If ChI = #027 then
  825.                    Txt := Int_to_Str(W);
  826.  
  827.              end
  828.              else
  829.              begin
  830.                  If (Temp < Min) or (Temp > Max) then
  831.                  begin
  832.                     OutOfRange_Message(Yt,Int_To_Str(Min),Int_To_Str(Max),ChI);
  833.                     If ChI = #027 then
  834.                        Txt := Int_to_Str(W);
  835.                  end
  836.                  else
  837.                  begin
  838.                      W := temp;
  839.                      Valid := true;
  840.                  end;
  841.             end;
  842.         end;
  843.     Until Valid  or ((R_Char = #027) and RTTT.AllowEsc);
  844. end;
  845.  
  846. Procedure Read_LongInt(X,Y,L:byte;
  847.                    Prompt:StrScreen;
  848.                    BoxType: byte;
  849.                    Var W : longint;
  850.                    Min, Max : longint);
  851. var
  852.    Temp : longint;
  853.    Txt : StrScreen;
  854.    Valid : boolean;
  855.    Code : integer;
  856.    YT : byte;
  857.    ChI : char;
  858. begin
  859.     If Max = 0 then
  860.       Max := MaxLongInt;
  861.     If Min >= Max then
  862.        Min := MinLongInt;
  863.     If (W < Min) or (W > Max) then
  864.         W := Min;
  865.     If ((W = 0) and RTTT.SuppressZero) then
  866.        Txt := ''
  867.     else
  868.        Txt := Int_To_Str(W);
  869.     Temp := W;
  870.     Valid := false;
  871.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  872.     YT := MessageLine(Y);
  873.     Repeat
  874.          Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,5,Txt);
  875.          If ((R_Char = #027) and RTTT.AllowEsc)
  876.          or ((Txt = '') and (RTTT.AllowNull)) then
  877.          begin
  878.              If Txt = '' then R_Null := true;
  879.              exit;
  880.          end
  881.          else
  882.          begin
  883.              val(Txt,Temp,code);
  884.              If code <> 0 then
  885.              begin
  886.                 Invalid_Message(YT,ChI);
  887.                 If ChI = #027 then
  888.                    Txt := Int_to_Str(W);
  889.              end
  890.              else
  891.              begin
  892.                  If (Temp < Min) or (Temp > Max) then
  893.                  begin
  894.                     OutOfRange_Message(Yt,Int_To_Str(Min),Int_To_Str(Max),ChI);
  895.                     If ChI = #027 then
  896.                        Txt := Int_to_Str(W);
  897.                  end
  898.                  else
  899.                  begin
  900.                      W := temp;
  901.                      Valid := true;
  902.                  end;
  903.             end;
  904.         end;
  905.     Until Valid  or ((R_Char = #027) and RTTT.AllowEsc);
  906. end;
  907.  
  908. Procedure Read_Real(X,Y,L:byte;
  909.                     Prompt:StrScreen;
  910.                     BoxType: byte;
  911.                     Var W : real; 
  912.                     Min, Max : real);
  913. var
  914.    Temp : Real;
  915.    Txt : StrScreen;
  916.    Valid : boolean;
  917.    Code : integer;
  918.    YT : byte;
  919.    ChR : char;
  920. begin
  921.     If Max = 0 then
  922.       Max := 99999999;
  923.     If Min >= Max then
  924.        Min := -99999999;
  925.     If (W < Min) or (W > Max) then
  926.         W := Min;
  927.     If Min < 0 then    {add room for - sign}
  928.        Inc(L);
  929.     If ((W = 0.0) and RTTT.SuppressZero) then
  930.        Txt := ''
  931.     else
  932.        Txt := Real_To_Str(W,RTTT.RealDP);
  933.     Temp := W;
  934.     Valid := false;
  935.     YT := MessageLine(Y);
  936.     Repeat
  937.          Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,7,Txt);
  938.          If ((R_Char = #027) and RTTT.AllowEsc)
  939.          or ((Txt = '') and (RTTT.AllowNull)) then          
  940.          begin
  941.              If Txt = '' then R_Null := true;
  942.              exit;
  943.          end
  944.          else
  945.          begin
  946.              val(Txt,Temp,code);
  947.              If code <> 0 then
  948.              begin
  949.                 Invalid_Message(YT,ChR);
  950.                 If ChR = #027 then
  951.                    Txt := Real_to_Str(W,RTTT.RealDP);
  952.              end
  953.              else
  954.              begin
  955.                  If (Temp < Min) or (Temp > Max) then
  956.                  begin
  957.                     OutOfRange_Message(Yt,Real_To_Str(Min,RTTT.RealDP),Real_To_Str(Max,RTTT.RealDP),ChR);
  958.                     If ChR = #027 then
  959.                        Txt := Real_to_Str(W,RTTT.RealDP);
  960.                  end
  961.                  else
  962.                  begin
  963.                      W := temp;
  964.                      Valid := true;
  965.                  end;
  966.             end;
  967.         end;
  968.     Until Valid  or ((R_Char = #027) and RTTT.AllowEsc);
  969. end;
  970.   
  971. Procedure Read_Select(X,Y:byte;Pmt,Txt:StrScreen;var Choice:byte);
  972. Const
  973.      UpChar:string[1] = '^';
  974.      JoinChar:string[1] = '_';
  975. var
  976.   W : byte;
  977.   I : integer;
  978.   Horiz : boolean;
  979.      Function Replace_JoinChar(Str:string): string;
  980.      {}
  981.      var I : integer;
  982.      begin
  983.          For I := 1 to length(Str) do
  984.              If Str[I] = JoinChar then
  985.                 Str[I] := ' ';
  986.          Replace_JoinChar := Str;
  987.      end; {of func Replace_JoinChar}
  988.  
  989.      Procedure HiLightWord(W:byte;Hi:boolean);
  990.      var Col : byte;
  991.      begin
  992.          If Hi then
  993.             Col := attr(RTTT.HiFCol,RTTT.HiBcol)
  994.          else
  995.             Col := attr(RTTT.LoFcol,RTTT.LoBcol);
  996.          If Horiz then
  997.              Fastwrite(pred(X)+PosWord(W,Txt),Y,Col,Replace_JoinChar(ExtractWords(W,1,Txt)))
  998.          else
  999.              Fastwrite(X,pred(Y)+W,Col,Replace_JoinChar(ExtractWords(W,1,Txt)));
  1000.          If Hi then
  1001.          begin
  1002.             If Horiz then
  1003.                GotoXY(pred(X)+PosWord(W,Txt),Y)
  1004.             else
  1005.                GotoXY(X,Pred(Y)+W);
  1006.          end;
  1007.      end;
  1008.  
  1009.      Procedure Process_Keys;
  1010.      var
  1011.        ChP : char;
  1012.        Finished : boolean;
  1013.      begin
  1014.          Finished := false;
  1015.          Repeat
  1016.               ChP := getKey;
  1017.               If ChP in RTTT.End_Chars then
  1018.                   Finished := True
  1019.               else
  1020.               Case upcase(ChP) of
  1021.               EscKey      : If RTTT.AllowEsc then
  1022.                                 Finished := true;
  1023.               ' ',#9,                                 {tab}
  1024.               CursorDown,
  1025.               CursorRight : begin
  1026.                                 HiLightWord(Choice,false);
  1027.                                 If Choice < W then
  1028.                                    Inc(Choice)
  1029.                                 else
  1030.                                    Choice := 1;
  1031.                                 HiLightWord(Choice,true);
  1032.                             end;
  1033.               #143,                     {Shift tab}
  1034.               CursorUp,
  1035.               CursorLeft  : begin
  1036.                                 HiLightWord(Choice,false);
  1037.                                 If Choice > 1 then
  1038.                                    Dec(Choice)
  1039.                                 else
  1040.                                    Choice := W;
  1041.                                 HiLightWord(Choice,true);
  1042.                             end;
  1043.               #131        : If (Choice < W) and Horiz then    {mouse right}
  1044.                             begin
  1045.                                 HiLightWord(Choice,false);
  1046.                                 Inc(Choice);
  1047.                                 HiLightWord(Choice,true);
  1048.                             end;
  1049.               #130        : If (Choice > 1) and Horiz then    {mouse left}
  1050.                             begin
  1051.                                 HiLightWord(Choice,false);
  1052.                                 Dec(Choice);
  1053.                                 HiLightWord(Choice,true);
  1054.                             end;
  1055.               #129        : If (Choice < W) and (Horiz = false) then    {mouse down}
  1056.                             begin
  1057.                                 HiLightWord(Choice,false);
  1058.                                 Inc(Choice);
  1059.                                 HiLightWord(Choice,true);
  1060.                             end;
  1061.               #128        : If (Choice > 1) and (Horiz = false) then    {mouse up}
  1062.                             begin
  1063.                                 HiLightWord(Choice,false);
  1064.                                 Dec(Choice);
  1065.                                 HiLightWord(Choice,true);
  1066.                             end;
  1067.  
  1068.               end; {case}
  1069.          until Finished;
  1070.          R_Char := ChP;
  1071.      end;
  1072.  
  1073. begin
  1074.     If Txt[1] = UpChar then
  1075.     begin
  1076.         Horiz := False;
  1077.         Delete(Txt,1,1);
  1078.     end
  1079.     else
  1080.        Horiz := true;
  1081.     W := Wordcnt(Txt);
  1082.     If W < 2 then exit;              {only show choices if there are two or more}
  1083.     FindCursor(Cursor_X,Cursor_Y,ScanTop,ScanBot);   {record cursor settings}
  1084.     If (Choice > W) or (Choice < 1) then               {check that W is sensible}
  1085.        Choice := 1;
  1086.     If Pmt <> '' then
  1087.     begin
  1088.         Fastwrite(X,Y,attr(RTTT.PFcol,RTTT.PBCol),Pmt);
  1089.         X := X+length(Pmt);
  1090.     end;
  1091.     For I := 1 to W do
  1092.         HiLightWord(I,False);
  1093.     OnCursor;
  1094.     HiLightWord(Choice,True);
  1095.     Process_keys;
  1096.     GotoXY(Cursor_X,Cursor_Y);           {reset cursor}
  1097.     SizeCursor(ScanTop,ScanBot);
  1098. end;  {proc Read_Select}
  1099.  
  1100. begin
  1101.    Default_Settings;
  1102. end.
  1103.